home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er
/
64ER_CD.iso
/
sh1x
/
sh11b.d64
/
klima 64_a
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
1995-03-30
|
10KB
|
365 lines
1 IFPEEK(56)<>143THENPOKE56,143:POKE52,143:CLR:LOAD"HARDCOPY",8,1
2 :
10 REM ************************
12 REM * KLIMA 64 VERSION 2.0 *
14 REM * MATTHIAS KRIESELL *
16 REM * OSTPREUSSENSTRASSE 6 *
18 REM * 3057 NEUSTADT A.R. *
20 REM * TEL.: 05032/5880 *
22 REM ************************
24 :
100 REM *** M-ROUTINEN ****************
102 IN=49152:CL=49397:AN=49460
104 AU=49479:PR=50688:PL=50746
106 LI=50761:CH=49254:FO=2159
108 :
200 REM *** INITIALISIEREN ************
202 SYS49152:REM PR.I/O AKTIVIEREN
204 C1$=CHR$(13):C2$=CHR$(20)
206 OP$="DATEN,L,"+CHR$(38)
208 QW=255:DIMQQ$(QW)
210 DIMT(12),N(12),R(12),MO$(12)
212 FORI=1TO12:READMO$(I):NEXT
214 Z$=CHR$(0)
216 H4$="[197]RFA\TE [207]RTE AUSGEBEN"
218 XL=174:XH=175:YA=176:Z=130
220 BW$="[194]ITTE W@HLEN [211]IE:"
222 C$(0)=" "
224 C$(1)=" "
226 POKE650,128
900 REM *** ERSTE INDIZIERUNG *********
902 OPEN1,8,15:SV=0:GOSUB7020
904 :
1000 REM *** HAUPTMENU ****************
1002 GOSUB7000
1004 SYSPR,132,4,"[200]AUPTMENU"
1006 SYSPR,115,7,BW$
1008 SYSPR,101,9,"1) [203]LIMAWERTE EINGEBEN"
1010 SYSPR,100,11,"2) [203]LIMADIAGRAMM ERSTELLEN"
1012 SYSPR,100,13,"3) [200]ILFSPROGRAMME"
1014 SYSPR,100,15,"4) [208]ROGRAMM BEENDEN"
1016 A=17:W$="4":GOSUB8050
1018 ONAGOTO2000,3000,1200,1100
1020 :
1100 REM *** PROGRAMM BEENDEN *********
1102 GOSUB7000
1104 SYSPR,112,4,"[208]ROGRAMM BEENDEN"
1106 A=7:GOSUB8070:IFNOTATHEN1000
1108 GOSUB7060
1110 CLOSE1:POKE53281,0:PRINT"[144][147]":SYSAU:SYS64738
1112 :
1200 REM *** HILFSPROGRAMME ***********
1202 GOSUB7000
1204 SYSPR,118,4,"[200]ILFSPROGRAMME"
1206 SYSPR,115,7,BW$
1208 SYSPR,101,9,"1) [203]LIMAWERTE AUSGEBEN"
1210 SYSPR,100,11,"2) [203]LIMAWERTE @NDERN"
1212 SYSPR,100,13,"3) "+H4$
1214 SYSPR,100,15,"4) [196]ATEI AKTUALISIEREN"
1216 SYSPR,100,17,"5) [193]NDERE [196]ATENDISKETTE INDIZIEREN"
1218 SYSPR,100,19,"6) [206]EUE [196]ATEI ANLEGEN"
1220 SYSPR,100,21,"7) [218]UR^CK ZUM [200]AUPTMENU"
1222 W$="7":A=23:GOSUB8050
1224 ONAGOTO1300,1350,1400,1250,1270,1500,1000
1226 :
1250 REM *** DATEI AKTUALISIEREN ******
1252 GOSUB7000
1254 SYSPR,108,4,"[196]ATEI AKTUALISIEREN"
1256 GOSUB7080
1258 GOTO1200
1260 :
1270 REM *** ANDERE DISKETTE **********
1272 GOSUB7000
1274 SYSPR,92,4,"[193]NDERE [196]ISKETTE INDIZIEREN"
1276 GOSUB7060
1278 GOSUB7020
1280 GOTO1200
1282 :
1300 REM *** AUSGABE ******************
1302 GOSUB7000
1304 SYSPR,105,4,"[203]LIMAWERTE AUSGEBEN"
1306 GOSUB7130:IFD=0THEN1200
1308 GOSUB2100
1310 GOSUB8080:GOTO1200
1312 :
1350 REM *** AENDERN ******************
1352 GOSUB7000
1354 SYSPR,110,4,"[203]LIMAWERTE @NDERN"
1356 GOSUB7130:IFD=0THEN1200
1358 GOSUB2100:GOSUB2200
1360 GOSUB2400:GOTO1200
1362 :
1400 REM *** ORTE AUSGEBEN ************
1402 I=0
1404 GOSUB7000
1406 SYSPR,101,4,"[197]RFA\TE [207]RTE AUSGEBEN"
1408 IFQQ=0THENSYSPR,0,7,"[203]EINE [207]RTE ERFA\T.":GOSUB8000:GOTO1200
1410 I=I+1:SYSPR,0,6+I-INT((I-1)/10)*10,QQ$(I):IFI=QQTHEN1420
1412 IFINT(I/10)<>I/10THEN1410
1414 I=I+1:SYSPR,160,6+I-INT((I-1)/10)*10,QQ$(I):IFI=QQTHEN1420
1416 IFINT(I/10)<>I/10THEN1414
1418 POKEYA,20:GOSUB8080:GOTO1404
1420 POKEYA,20:GOSUB8080:GOTO1200
1422 :
1500 REM *** DATEI ANLEGEN ************
1501 GOSUB7000
1502 SYSPR,110,4,"[206]EUE [196]ATEI ANLEGEN"
1503 GOSUB7060
1504 GOSUB7000
1505 SYSPR,110,4,"[206]EUE [196]ATEI ANLEGEN"
1506 SYSPR,0,7,"[194]ITTE LEGEN [211]IE EINE FORMATIERTE [196]ISKETTE IN"
1508 SYSPR,0,9,"[204]AUFWERK #0. [196]IESE [196]ISKETTE WIRD EINE K^NFTIGE"
1510 SYSPR,0,11,"[196]ATENDISKETTE."
1512 SYSPR,0,13,"[198]ERTIG"
1514 GOSUB8030:IFNOTATHEN1200
1516 PRINT#1,"I":GOSUB8010:IFA<>0THENCLR:RUN
1518 PRINT#1,"M-R"+CHR$(250)+CHR$(2)+CHR$(3):GET#1,A$,B$,B$
1520 A=ASC(A$+Z$)+256*ASC(B$+Z$)
1522 IFA>200THEN1534
1524 SYSPR,0,16,"[193]UF DER EINGELEGTEN [196]ISKETTE IST NICHT"
1526 SYSPR,0,18,"MEHR GEN^GEND [211]PEICHERRAUM VORHANDEN."
1528 SYSPR,0,20,"[193]NDERE [196]ISKETTE PROBIEREN"
1530 GOSUB8030:IFNOTATHENCLR:RUN
1532 GOTO1500
1534 OPEN2,8,2,OP$
1536 PRINT#1,"P"+CHR$(2)+CHR$(QW)+Z$+Z$
1538 INPUT#1,A,A$,A1,A2:IFA<>0THEN1546
1540 SYSPR,0,16,"[193]UF DER EINGELEGTEN [196]ISKETTE BEFINDET SICH"
1542 SYSPR,0,18,"BEREITS EINE '[203]LIMA 64'-[196]ATEI."
1544 GOTO1528
1546 SYSPR,0,16,"[194]ITTE WARTEN..."
1548 PRINT#2,CHR$(255)
1550 CLOSE2:INPUT#1,A,A$,A1,A2:CLR:RUN
1552 :
2000 REM *** WERTE EINGEBEN ***********
2002 GOSUB7000
2004 SYSPR,110,4,"[203]LIMAWERTE EINGEB[138]N"
2006 OT$=""
2008 FORI=1TO12:T(I)=0:N(I)=0:NEXT
2010 GOSUB2100:GOSUB2200
2012 GOSUB7000
2014 SYSPR,110,4,"[203]LIMAWERTE EINGEBEN"
2016 SYSPR,0,7,OT$+" ERFASSEN"
2018 GOSUB8030:IFNOTATHEN1000
2020 QQ=QQ+1:D=QQ:GOSUB2400:GOTO1000
2022 :
2100 REM *** FORMULAR *****************
2102 SYSPR,0,7,"[207]RT:"+OT$
2104 SYSPR,2,9,"[205]ONAT [212]EMP.":SYSPR,113,9,"[206][196]."
2106 SYSLI,0,69,155,69
2108 SYSLI,0,81,155,81
2110 SYSLI,0,189,155,189
2112 SYSLI,0,69,0,189
2114 SYSLI,67,69,67,189
2116 SYSLI,111,69,111,189
2118 SYSLI,155,69,155,189
2120 FORI=1TO12
2122 SYSPR,2,10+I,MO$(I)
2124 SYSPR,69,10+I,MID$(STR$(T(I)),2)
2126 SYSPR,113,10+I,MID$(STR$(N(I)),2)
2128 NEXT
2130 RETURN
2132 :
2200 REM *** EINGABE/AENDERN **********
2202 W$=OT$:W=20:X=20:Y=7:GOSUB7100:OT$=X$
2204 FORI=1TO12
2206 W$=MID$(STR$(T(I)),2):W=3:X=69:Y=10+I:GOSUB7100:T(I)=VAL(X$)
2208 NEXT
2210 FORI=1TO12
2212 W$=MID$(STR$(N(I)),2):W=3:X=113:Y=10+I:GOSUB7100:N(I)=VAL(X$)
2214 NEXT
2216 SYSPR,2,24,"[211]IND ALLE [193]NGABEN KORREKT"
2218 GOSUB8030:IFNOTATHEN2202
2220 RETURN
2222 :
2400 REM *** ORT ABSPEICHERN **********
2402 QQ$(D)=OT$:SV=0
2404 OPEN2,8,2,OP$
2406 A$="":FORI=1TO12
2408 A$=A$+CHR$(50+T(I))+CHR$(N(I)AND255)+CHR$(N(I)/256)
2410 NEXT
2412 PRINT#1,"P"+CHR$(2)+CHR$(D)+Z$+Z$
2414 PRINT#2,A$
2416 CLOSE2
2418 RETURN
2420 :
3000 REM *** DIAGRAMM *****************
3002 GOSUB7000
3004 SYSPR,92,4,"[203]LIMADIAGRAMM ERSTELLEN"
3006 GOSUB7130:IFD=0THEN1000
3007 SYSFO
3008 SYSPR,0,0,OT$+", [203]LIMA"
3014 FORI=1TO12:R(I)=N(I):IFN(I)>100THENR(I)=100+((N(I)-100)/10)
3016 NEXT
3018 T(0)=(T(1)+T(12))/2
3020 R(0)=(R(1)+R(12))/2
3022 SYSLI,13,Z-T(0)*2,18,Z-T(1)*2
3024 SYSLI,13,Z-R(0),18,Z-R(1)
3026 FORI=2TO12
3028 SYSLI,8+(I-1)*10,Z-T(I-1)*2,8+I*10,Z-T(I)*2
3030 SYSLI,8+(I-1)*10,Z-R(I-1),8+I*10,Z-R(I)
3032 NEXT
3034 SYSLI,128,Z-T(12)*2,133,Z-T(0)*2
3036 SYSLI,128,Z-R(12),133,Z-R(0)
3038 FORI=1TO12
3040 IFR(I)>T(I)*2THENSYSLI,8+I*10,Z-R(I),8+I*10,Z-T(I)*2:GOTO3046
3042 IFINT(R(I)/5)=INT(T(I)*2/5)THEN3046
3044 FORJ=INT(R(I)/5+.5)*5+2.5TO(T(I)*2)-2.5STEP5:SYSPL,8+I*10,Z-J:NEXT
3046 NEXT
3048 FORI=2TO12:R=(R(I-1)+R(I))/2:T=T(I-1)+T(I)
3050 IFR>TTHENSYSLI,3+I*10,Z-R,3+I*10,Z-T:GOTO3056
3052 IFINT(R/5)=INT(T/5)THEN3056
3054 FORJ=INT(R/5+.5)*5+2.5TOT-2.5STEP5:SYSPL,3+I*10,Z-J:NEXT
3056 NEXT
3058 FORI=1TO11
3060 DR=(R(I+1)-R(I))/10
3062 FORJ=0TO9:A=8+I*10+J
3064 IF(J*DR)+R(I)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(I))
3066 NEXT:NEXT
3068 DR=(R(1)-R(0))/10
3070 FORJ=5TO9:A=8+J
3072 IF(J*DR)+R(0)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(0))
3074 NEXT
3076 DR=(R(0)-R(12))/10
3078 FORJ=0TO5:A=128+J
3080 IF(J*DR)+R(12)>100THENSYSLI,A,30,A,130-(INT(J*DR+.5)+R(12))
3082 NEXT
3084 :
3200 A=0:TL=50:TH=-50:NL=9999:NH=0
3202 S1=0:S2=0:FORI=1TO12
3204 IFN(I)>2*T(I)THENA=A+1
3206 IFT(I)<TLTHENTL=T(I):T1=I
3208 IFT(I)>THTHENTH=T(I):T2=I
3210 IFN(I)<NLTHENNL=N(I):N1=I
3212 IFN(I)>NHTHENNH=N(I):N2=I
3214 S1=S1+T(I):S2=S2+N(I)
3216 NEXT:A=INT(A*100/12)
3217 IFTL<0THENSYSLI,13,Z,13,Z-TL*2:FORI=ZTOZ-TL*2STEP10:SYSPL,12,I:NEXT
3218 SYSPR,170,3,"[211]TATISTIK"
3220 SYSPR,170,5,"[200]UMIDES [203]LIMA:"+STR$(A)+" %"
3222 SYSPR,170,6,"[193]RRIDES [203]LIMA:"+STR$(100-A)+" %"
3224 SYSPR,170,7,"[212]EMPERATUREN:"
3226 SYSPR,170,8,"[205]IN.:"+STR$(TL)+" ("+MO$(T1)+")"
3228 SYSPR,170,9,"[205]AX.:"+STR$(TH)+" ("+MO$(T2)+")"
3230 SYSPR,170,10,"[196]URCHSCHNITT:"+STR$(INT(S1/12))
3232 SYSPR,170,11,"[206]IEDERSCHLAG:"
3234 SYSPR,170,12,"[205]IN.:"+STR$(NL)+" MM ("+MO$(N1)+")"
3236 SYSPR,170,13,"[205]AX.:"+STR$(NH)+" MM ("+MO$(N2)+")"
3238 SYSPR,170,14,"[196]URCHSCHNITT:"+STR$(INT(S2/12))+" MM"
3240 SYSPR,170,15,"[199]ESAMT:"+STR$(S2)+" MM"
3242 POKEYA,22:GOSUB8080
3244 GOTO1000
3246 :
7000 REM *** TITEL ********************
7002 SYSCL
7004 SYSLI,100,8,220,8
7006 SYSPR,112,0,"[203]LIMADIAGRAMM 64"
7008 SYSPR,64,2," [215]RITTEN 1986 BY [205]ATTHIAS [203]RIESELL"
7010 RETURN
7012 :
7020 REM *** INDIZIEREN ***************
7022 GOSUB7000
7024 SYSPR,107,4,"[196]ISKETTE INDIZIEREN"
7026 SYSPR,0,7,"[194]ITTE LEGEN [211]IE EINE [196]ATEINDISKETTE IN [204]AUFWERK #0."
7028 A=9:GOSUB8000
7030 PRINT#1,"I"
7032 GOSUB8010:IFATHENRETURN
7034 OPEN2,8,2,"INDEX,P,R"
7036 INPUT#2,QQ:IFQQ>0THEN7050
7038 INPUT#1,A,A$,A1,A2:CLOSE2
7040 SYSPR,0,12,"[193]CHTUNG ! [197]S SIND NOCH KEINE [203]LIMAWERTE AUF DER"
7042 SYSPR,0,14,"EINGELEGTEN [196]ISKETTE ABGESPEICHERT."
7044 SYSPR,0,16,"[215]OLLEN [211]IE EINE ANDERE [196]ISKETTE INDIZIEREN"
7046 GOSUB8030:IFATHEN7020
7048 RETURN
7050 SYSPR,0,12,"[193]NZAHL DER BISHER ERFA\TEN [207]RTE:"+STR$(QQ)
7052 FORI=1TOQQ:INPUT#2,QQ$(I):NEXT
7054 CLOSE2:SV=1:RETURN
7056 :
7060 REM *** TEST AUF AKTUELL *********
7062 IFSVTHENRETURN
7064 A=PEEK(YA)
7066 SYSPR,0,A+3,"[193]CHTUNG ! [196]IE [201]NDEXDATEI IST NICHT MEHR AKTUELL."
7068 SYSPR,0,A+5,"[211]OLL SIE AKTUALISIERT WERDEN"
7070 GOSUB8030:IFNOTATHENRETURN
7072 :
7080 REM *** AKTUALISIEREN ************
7082 A=PEEK(YA)
7084 SYSPR,0,A+3,"[196]IE [196]ATEI WIRD NUN AKTUALISIERT, BITTE WARTEN [211]IE.
7086 [158]PR,0,A[170]5,"(STR$ISKETTE IM (null)AUFWERK BELASSEN, SONST STR$ATENVERLUST !!)"
7088 [152]1,"S0:INDEX":[132]1,A
7090 [139]QQ[178]0[167][142]
7092 [159]2,8,2,"INDEX,P,W":[152]2,QQ
7094 [129]I[178]1[164]QQ:[152]2,QQ$(I):[130]
7096 [160]2:[142]
7098 :
7100 [143] *** EINGABEROUTINE ***********
7102 X$[178]"":A[178]0:[158]PR,X,Y,C$([171](W[179]5))
7104 [151]XL,X:[151]XH,[171](X[177]255):[151]YA,Y
7106 A1[178][194](XL):A2[178][194](XH)
7108 [151]780,219:[158]CH
7110 [151]XL,A1:[151]XH,A2
7112 [161]A$:[139]A$[178]"="[167][139]A[178]0[167][139]W$[179][177]""[167]X$[178]W$:A[178][195](X$):[158]PR,X,Y,X$:[142]
7114 [139]A$[178]C1$[167][139]A[177]0[167][151]780,32:[158]CH:[142]
7116 [139]A$[178]C2$[167][139]A[177]0[167]7102
7118 [139]A$[178][199](34)[176]A[178]W[167]7112
7120 [139]A$[178]"^"[176]A$[178]"\"[167]7124
7122 [139]A$[179]" "[176]A$[177]"Z"[167][139]A$[179]"ATN"[176]A$[177]"(null)"[167]7112
7124 X$[178]X$[170]A$:A[178]A[170]1:[151]780,[198](A$):[158]CH:[137]7106
7126 :
7130 [143] *** ORT HOLEN ****************
7132 [139]QQ[178]0[167]D[178]0:[158]PR,0,7,"(null)EINE (null)RTE ERFA\T.":[137]8000
7134 [158]PR,0,7,"(null)RT:":W$[178]"":W[178]20:X[178]20:Y[178]7:[141]7100:OT$[178]X$
7136 D[178]0
7138 D[178]D[170]1:[139]D[179][178]QQ[167][139]OT$[179][177]QQ$(D)[167]7138
7140 [139]D[177]QQ[167]D[178]0:[158]PR,0,9,"(null)RT NICHT ERFA\T.":[137]8000
7142 [159]2,8,2,OP$
7144 [152]1,"P"[170][199](2)[170][199](D)[170]Z$[170]Z$
7146 [129]I[178]1[164]12
7148 [161]#2,A$,B$,C$:T(I)[178][198](A$[170]Z$)[171]50
7150 N(I)[178][198](B$[170]Z$)[170]256[172][198](C$[170]Z$)
7152 [130]:[160]2:[142]
7154 :
8000 [143] *** "RETURN" *****************
8002 [158]PR,0,[194](YA)[170]2,"STR$R^CKEN (null)IE [(null)VAL(null)(null)(null)(null)]."
8004 [161]A$:[139]A$[179][177][199](13)[167]8004
8006 [142]
8008 :
8010 [143] *** FEHLERKANAL LESEN ********
8012 [132]1,A,A$,A1,A2
8014 [139]A[178]0[176]A[178]50[167][142]
8016 B[178][194](YA)
8018 [158]PR,0,B[170]3,"STR$ISK-VALRROR #"[170][202]([196](A),2)[170]": "[170]A$
8020 A[178]B[170]5:[137]8000
8022 :
8030 [143] *** "JA/NEIN" ****************
8032 [158]PR,[194](XL)[170]256[172][194](XH),[194](YA)," (MID$/(null)) ?"
8034 [161]A$:[139]A$[179][177]"J"[175]A$[179][177]"N"[167]8034
8036 [151]780,[198](A$)[170]32:[158]CH
8038 A[178](A$[178]"J"):[142]
8040 :
8050 [143] *** WAHL *********************
8052 [158]PR,115,A,"RIGHT$HRE (null)AHL (1-"[170]W$[170]"):"
8054 [161]A$:[139]A$[179]"1"[176]A$[177]W$[167]8054
8056 [151]780,[198](A$):[158]CH
8058 A[178][197](A$) :[142]
8060 :
8070 [143] *** "SICHER ?" ***************
8072 [158]PR,98,A,"(null)IND (null)IE SICHER"
8074 [137]8030
8076 :
8080 [143] *** HARDCOPY *****************
8082 [158]PR,0,[194](YA)[170]2,"LEFT$ARDCOPY ERSTELLEN"
8084 [141]8030:[139][168]A[167][142]
8086 [158]PR,0,[194](YA),C$(0)
8088 [143] ***********************
8090 [143] * GGF. HARDCOPYAUFRUF *
8092 [143] * ABAENDERN. VGL.TEXT *
8094 [143] ***********************
8096 [158]36864:[142]
8098 :
9000 [143] *** DATEN ********************
9002 [131] "MID$ANUAR","ASCEBRUAR","(null)@RZ","ATNPRIL","(null)AI","MID$UNI","MID$ULI","ATNUGUST"
9004 [131] "(null)EPTEMBER","(null)KTOBER","(null)OVEMBER","STR$EZEMBER"
9006 :